COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "ANIMED"
C00005 00003	SUBR MOVED(INTEGER PF)
C00009 00004	SUBR LOOK
C00014 00005	SUBR GDEL(INTEGER T1,T2)
C00018 00006	MKUNIVGEODPYWO←DAD(UNIVERSE)N←FNUM←1
C00026 ENDMK
C⊗;
BEGIN "ANIMED"
	REQUIRE "GEOMES.HDR[CMS,LCS]" SOURCE_FILE;
	DEFINE MEM="MEMORY";DEFINE α="COMMENT";
	DEFINE SUBR="SIMPLE INTEGER PROCEDURE";
	STRING STR;REAL FO,RNOF;
	INTEGER ATR,CDAD,PDAD,PATR,CATR,NDAD;
	INTEGER TF,NFR,NT,TMP,CAMR,POP,DT;
	INTEGER CI,WO,CB,CHR,N,I,NOF;
	INTEGER CFR,CT,PFR,NAM1,NAM2,CD;
	INTERNAL INTEGER FNUM;
	SAFE INTEGER ARRAY BLIST[1:200];
	SUBR NINK(INTEGER Q);START_CODE HLRZ 1,Q;END;
	SUBR PINK(INTEGER Q);START_CODE HRRZ 1,Q;END;

SUBR COPTRM;
START_CODE
	HRRZ 1,NFR; MOVE 2,FNUM; CAME 2,(1);
	HRRZ 1,PFR; HRRZM 1,CFR; HRRZ 2,CB;
	HRRZ 1,6(1); HRLZI 1,-3(1); 
	HRRZ 2,6(2); HRRI 1,-3(2);
	BLT 1,8(2);
END;

SUBR DIFF(INTEGER Q1,Q2);
START_CODE LABEL L1;
	HRRZ 1,Q2; HRRZ 2,Q1;
	HRRZ 1,6(1); HRRZ 2,6(2);
	MOVE 3,-3(1); CAME 3,-3(2); JRST L1;
	MOVE 3,-2(1); CAME 3,-2(2); JRST L1;
	MOVE 3,-1(1); CAME 3,-1(2); JRST L1;
	MOVE 3,(1); CAME 3,(2); JRST L1;
	MOVE 3,1(1); CAME 3,1(2); JRST L1;
	MOVE 3,2(1); CAME 3,2(2); JRST L1;
	MOVE 3,3(1); CAME 3,3(2); JRST L1;
	MOVE 3,4(1); CAME 3,4(2); JRST L1;
	MOVE 3,5(1); CAME 3,5(2); JRST L1;
	MOVE 3,6(1); CAME 3,6(2); JRST L1;
	MOVE 3,7(1); CAME 3,7(2); JRST L1;
	MOVE 3,8(1); CAME 3,8(2); JRST L1;
	HRRZ 2,Q1; SKIPE 3,5(2); CAMN 3,3(1); CAIA;
    L1:	SKIPA 1,L1; SETZ 1,;
END;

SUBR SEEN(INTEGER B);
START_CODE
	LABEL LOOP,DONE,STAR;
	HRRZ 1,B; HRRZ 3,N; ADD 3,BLIST;
	SKIPE CAMR; HRRZI 1,LOOP;
	HRRZ 2,BLIST; JRST STAR;
	"α"; 0;
LOOP:	ADDI 2,3;
STAR:	CAIG 3,1(2); JRST DONE;
	MOVE 4,1(2); MOVE 5,2(2);
	CAMN 4,-2(1); CAME 5,-1(1);
	JRST LOOP; SUB 2,BLIST; AOJ 2,;
	SKIPA 1,2;
DONE:	SETZ 1,;
END;
SUBR MOVED(INTEGER PF);
BEGIN
	IF DAD(CB) THEN RETURN(-1)
	ELSE RETURN(DIFF(PF,CB));
END;


SUBR SEEIT(INTEGER D);
BEGIN
	IF ¬(CDAD←SEEN(D)) THEN BEGIN
	  BLIST[N]←0;BLIST[N+1]←MEM[D-2];
	  BLIST[N+2]←MEM[D-1];N←3+(CDAD←N);END;
	DAD$(CDAD,CFR);
END;

SUBR NOTSEEN;
BEGIN
	CFR←MKNODE(FNUM);CT←MKCOPY(TRAM(CB));
	IF (POP←DAD(CB))∧¬CAMR THEN SEEIT(POP);
	START_CODE LABEL NCAM;
	  HRRZ 1,CFR; HRRZ 2,CT;
	  HRRM 2,6(1); HRRZ 2,CB;
	  MOVE 2,FNUM; HRRM 2,4(1);
	  HRLI 1,(1); MOVEM 2,7(1);
	  SKIPN 3,I; HRRZ 3,N;
	  ADD 3,BLIST; MOVEM 1,-1(3);
	  HRRZ 1,CB; SKIPE CAMR;
	    HRRZI 1,NCAM; JRST NCAM; "α"; 0;
   NCAM:  MOVE 2,-1(1); MOVE 1,-2(1); MOVEM 1,(3);
	  MOVEM 2,1(3); HRRZI 1,3;
	  SKIPN I; ADDM 1,N; END;
END;

SUBR ADNODE;
BEGIN "ADNODE"
	CFR←MKNODE(FNUM);MVNUM$(FNUM,CFR);
	IF (POP←DAD(CB))∧¬CAMR THEN SEEIT(POP);
	CT←MKCOPY(TRAM(CB));TRAM$(CT,CFR);
	CW$(NFR,CFR);CCW$(PFR,CFR);
	CW$(CFR,PFR);CCW$(CFR,NFR);
END "ADNODE";

SUBR FLIP(INTEGER NUM,INDX);
BEGIN INTEGER PFRM,CFRM;
	PFRM←CFRM←NINK(BLIST[INDX]);
	IF SNUM(CFRM)<NUM THEN BEGIN
	  DO CFRM←CW(CFRM) UNTIL SNUM(CFRM)≥NUM∨CFRM=PFRM;
	  IF CFRM=PFRM THEN CFRM←CB;END;
	RETURN(CFRM);
END;

SUBR SETUP;
BEGIN
	IF (I←SEEN(CB)) THEN CFR←FLIP(FNUM,I)
	ELSE CFR←CB;
	NLINK$(CFR,CB);
END;
SUBR LOOK;
BEGIN
	IF ¬(I←SEEN(CB))∨¬BLIST[I] THEN NOTSEEN
	ELSE BEGIN
	  PFR←PINK(BLIST[I]);NFR←NINK(BLIST[I]);
	  IF MVNUM(PFR)≤FNUM THEN BEGIN "ATEND"
	    IF MVNUM(PFR)≠FNUM THEN
	      IF MOVED(PFR) THEN BEGIN
		ADNODE;
		BLIST[I]←XWD(NINK(BLIST[I]),CFR);END
	      ELSE MVNUM(FNUM,PFR)
	    ELSE IF SNUM(PFR)=FNUM THEN COPTRM
	    ELSE IF MOVED(PFR) THEN BEGIN
	      ADNODE;
	      BLIST[I]←XWD(NINK(BLIST[I]),CFR);
	      NT←SNUM(PFR);MVNUM$(NT,PFR);END;
	  END "ATEND"
	  ELSE IF SNUM(NFR)≥FNUM THEN BEGIN "ATBEG"
	    IF SNUM(NFR)≠FNUM THEN
	      IF MOVED(NFR) THEN BEGIN
		ADNODE;
		BLIST[I]←XWD(CFR,BLIST[I]);END
	      ELSE SNUM(NFR)←FNUM
	    ELSE IF MVNUM(NFR)=FNUM THEN COPTRM
	    ELSE IF MOVED(NFR) THEN BEGIN
	      ADNODE;
	      BLIST[I]←XWD(CFR,BLIST[I]);
	      SNUM(NFR)←MVNUM(NFR);END;
	  END "ATBEG"
	  ELSE BEGIN "FDFRM"
	    WHILE SNUM(PFR)≥FNUM DO PFR←CCW(PFR);
	    NFR←CW(PFR);
	    IF SNUM(NFR)=FNUM THEN
	      IF MVNUM(NFR)=FNUM THEN COPTRM
	      ELSE IF MOVED(PFR) THEN BEGIN
		ADNODE;SNUM(NFR)←MVNUM(NFR);END
	      ELSE BEGIN
		MVNUM$(FNUM,PFR);SNUM(NFR)←MVNUM(NFR);END
	    ELSE IF MVNUM(PFR)≤FNUM THEN
	      IF MOVED(PFR) THEN
		IF MOVED(NFR) THEN BEGIN
		  ADNODE;
		  IF MVNUM(PFR)=FNUM THEN BEGIN
		    NT←SNUM(PFR);MVNUM$(NT,PFR);END;END
		ELSE SNUM(NFR)←FNUM
	      ELSE MVNUM$(FNUM,PFR)
	    ELSE IF MOVED(PFR) THEN BEGIN
	      NT←NFR;NFR←MKNODE(MVNUM(PFR));
	      CT←MKCOPY(TRAM(PFR));TRAM$(CT,NFR);
	      CW$(NT,NFR);CCW$(NFR,NT);
	      NT←SNUM(NFR);MVNUM$(NT,NFR);ADNODE;END;
	  END "FDFRM";END;
END;
SUBR GDEL(INTEGER T1,T2);
START_CODE
	HRRZ 1,CFR; HRRZ 2,TMP;
	MOVE 3,-3(2); FDVR 3,RNOF; MOVEM 3,1(1);
	MOVE 3,-2(2); FDVR 3,RNOF; MOVEM 3,2(1);
	MOVE 3,-1(2); FDVR 3,RNOF; MOVEM 3,3(1);
	HRRZ 2,T1; HRRZ 3,T2;
	MOVE 4,-3(3); FSBR 4,-3(2); FDVR 4,RNOF; MOVEM 4,-3(1);
	MOVE 4,-2(3); FSBR 4,-2(2); FDVR 4,RNOF; MOVEM 4,-2(1);
	MOVE 4,-1(3); FSBR 4,-1(2); FDVR 4,RNOF; MOVEM 4,-1(1);
END;

SUBR MKDEL(INTEGER Q1,Q2);
BEGIN
	CT←TRAM(Q1);NT←TRAM(Q2);TMP←MKCOPY(CT);
	APTRAN(INTRAN(TMP),NT); CVTRMV(TMP);
	GDEL(CT,NT);KLNODE(TMP);
END;

SUBR MOVEIT;
BEGIN
	IF (CFR←NLINK(CB))≠CB∧MVNUM(CFR)≤FNUM THEN BEGIN
	  IF MVNUM(CFR)=FNUM THEN BEGIN
	    NFR←CW(CFR);
	    IF SNUM(NFR)>FNUM THEN BEGIN
	      RNOF←SNUM(NFR)-FNUM;
	      IF CAMR THEN MKDEL(CFR,NFR)
	      ELSE IF (POP←DAD(NFR)) THEN BEGIN
		CD←WO;
		DO CD←CW(CD) UNTIL
		 BLIST[POP+1]=MEM[CD-2]∧BLIST[POP+2]=MEM[CD-1];
		BATT(CB,CD);
		IF (CDAD←NLINK(CD))≠CD∧MVNUM(CDAD)=FNUM THEN BEGIN
		  NDAD←CW(CDAD);
		  IF SNUM(NDAD)>FNUM THEN BEGIN	INTEGER DTMP;
		    DTMP←MKCOPY(TRAM(CDAD));
		    APTRAN(INTRAN(DTMP),TRAM(NDAD));
		    TMP←MKCOPY(TRAM(CFR));
		    APTRAN(TMP,DTMP);
		    KLNODE(DTMP);
		    DTMP←MKCOPY(TMP);
		    APTRAN(INTRAN(TMP),TRAM(NFR));
		    CVTRMV(TMP);
		    GDEL(DTMP,TRAM(NFR));
		    KLNODE(TMP);KLNODE(DTMP);END;END
		ELSE MKDEL(CFR,NFR);END
	      ELSE IF DAD(CB) THEN BEGIN
		BDET(CB);MKDEL(CFR,NFR);END
	      ELSE MKDEL(CFR,NFR);END
	    ELSE BEGIN NLINK$(CB,CB);RETURN(0);END;END;
	  TRANSL(CB,XWC(CFR),YWC(CFR),ZWC(CFR));
	  ROTATE(XWD(-2,-CB),IY(CFR),IZ(CFR),JX(CFR));
	  TMP←CW(CFR);
	  IF SNUM(TMP)=FNUM+1 THEN NLINK$(TMP,CB);END;
END;

α		    DTMP←MKCOPY(TRAM(PDAD));
α		    APTRAM(INTRAM(DTMP),TRAM(NDAD));

α		    TMP←MKCOPY(TRAM(PFR));
α		    APTRAM(TMP,DTMP);
α		    KLNODE(DTMP);

α		    DTMP←MKCOPY(TMP);
α		    APTRAM(INTRAM(TMP),TRAM(NFR));
α		    CVTRMV(TMP);

α		    GDEL(DTMP,TRAM(NFR));

α		    KLNODE(TMP);
α		    KLNODE(DTMP);


SUBR MVCAM;
BEGIN
	TMP←0;CAMR←CB←NCCW(WO);MOVEIT;CAMR←0;
	IF TMP THEN BEGIN
	  FO←JX(CB);
	  JX(CB)←FO+(FOCAL(TMP)-FO)/(SNUM(TMP)-FNUM);
	  IF JX(CB)>0 THEN BEGIN
	    FO←JX(CB)/FO;XWC(CB)←XWC(CB)*FO;
	    YWC(CB)←YWC(CB)*FO;ZWC(CB)←ZWC(CB)*FO;END
	  ELSE JX(CB)←FO;END;
END;
MKUNIV;GEODPY;WO←DAD(UNIVERSE);N←FNUM←1;
WHILE TRUE DO BEGIN "COMS"

   EXTERNAL INTEGER ENTERS;
   GEOMED;
   IF ENTERS≠-1 THEN USERERR(1,1,"Some GEOMED routine exited wrong");
   CI←INCHRW;

   IF CI="A" THEN BEGIN "ADFRM"
	OUTSTR("
	FRM # "&CVS(FNUM)&"	FRM # = ");STR←INCHWL;
	IF LENGTH(STR)≠0 THEN FNUM←INTSCAN(STR,CHR);
	CAMR←CB←NCCW(WO);LOOK;
	IF CFR THEN FOCAL(CFR)←JX(CB);
	CAMR←0;CB←WO;
	WHILE (CB←CW(CB))≠WO DO LOOK;
   END "ADFRM";

   IF CI="R"∨CI="M"∨CI="P" THEN BEGIN "MKMOVI"
	OUTSTR("
	FRM # "&CVS(FNUM)&" 	START # = ");STR←INCHWL;
	IF LENGTH(STR)≠0 THEN FNUM←INTSCAN(STR,CHR);
	OUTSTR("	END # = ");STR←INCHWL;
	IF LENGTH(STR)≠0 THEN BEGIN
	TF←INTSCAN(STR,CHR);TF←TF+FNUM;
	CAMR←CB←NCCW(WO);SETUP;CAMR←0;CB←WO;
	WHILE WO≠(CB←CW(CB)) DO SETUP;
	WHILE FNUM<TF DO BEGIN "FRAMES"
	  CASE CI OF BEGIN
	    ["R"] GEODPY;
	    ["P"] BEGIN GEODPY;PLTO;END;
	    ["M"] BEGIN SHOW2(0,0);PLTO;END END;
	  MVCAM;CB←WO;
	  WHILE WO≠(CB←CW(CB)) DO MOVEIT;
	  FNUM←FNUM+1;END "FRAMES";
	FNUM←FNUM-1;END;
   END "MKMOVI";

END "COMS";

END "ANIMED";